perm filename PASS2.SAI[PUB,TES]4 blob
sn#146877 filedate 1975-02-19 generic text, type T, neo UTF8
00100 BEGIN "PUB2"
00200 COMMENT NOTE THAT THE PARCVER USES MEMORY PAGES 700-712 AS A BUFFER ;
00300 REQUIRE "[]<>" DELIMITERS ;
00400 REQUIRE "SITE" SOURCE!FILE;
00500 REQUIRE 6500 STRING!SPACE ;
00600 DEFINE
00700 PASSONE = [FALSE],
00800 PASSTWO = [TRUE],
00900 BEGOF(NAME) = [ ],
01000 ENDOF(NAME) = [ ],
01100 PROCEDURES = [ ],
01200 FINISHED = [ ],
01300 PUBLIC = [ ],
01400 PRIVATE = [ ],
01500 $ = ["],
01600 # = [],
01700 IFK = [IFC],
01800 THENK = [THENC],
01900 IFSITE = [IFK],
02000 SITE(DUMMY) = [ ],
02100 TERNAL = [] ;
02200 REQUIRE "COMMON" SOURCE!FILE ;
02300 COMMENT The Document Compiler -- Pass Two ;
02400 COMMENT Pass One and Two share certain declarations, but in
02500 one case, the meaning of a variable is different:
02600 In Pass 1, XCRIBL is true for either
02700 an XGP -or- PARC's MIC.
02800 In Pass 2, XCRIBL is only true for an
02900 XGP. MICRO is true for PARC's MIC
03000 and RASTER is true for both. ;
03100 COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
03200 Height Width MillLeftMargin MillRightMargin
03300 For each area:
03400 UpperLine NumCols NumLines
03500 For each column:
03600 LeftChar
03700 For each non-null line:
03800 Line Number
03900 How far short of justification
04000 Excess mill leading
04100 Index of Intermediate Ascii File line
04200 0
04300 -10
04400
04500 PASS 2 reads the output file name and the intermediate page file names from
04600 PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
04700 each page from each page file, processes each line in each of
04800 its areas, and writes out a line printer image on the output file.
04900
05000 Each line is subject to three operations, in this order:
05100 (1) Substitute label values at each vertical tab.
05200 (2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
05300 (3) Generate underlining and super/sub-scripting as indicated by rubouts.
05400
05500 ;
05600
05700 IFC CMUVER THENC REQUIRE "PUBTMP.SAI" SOURCE!FILE;
05800 ENDC COMMENT RKJ: 26-SEP-74;
05900
06000 DEFINE THRU = [STEP 1 UNTIL], DOWN = [STEP -1 UNTIL],
06100 LH(X) = [(X LSH -18)], RH(X) = [(X LAND '777777)],
06200 AWHILE = [WHILE TRUE],
06300 INNUM = [WORDIN(ICHAN)],
06400 SCN(BRKTBL)= [(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))],
06500 SCNUM = [CVD(SCN(TO!ALTMODE!SKIP))],
06600 LPT = [1], TTY = [2], MIC = [3], XGP = [4],
06700 HORIZ= ['40], VERTI= ['41], CSIZE= ['42], ULINE= ['43], RSPCS= ['44],
06800 LSPCS= ['45], UDOTS= ['46], RDOTS= ['47], comment FR80 escape codes ;
06900 FULSTR(X) = [LENGTH(X)], NULSTR(X) = [(LENGTH(X)=0)],
07000 CR = ['15], LF = ['12], VT = ['13], FF = ['14], SP = ['40],
07100 RUBOUT = ['177], TB = ['11],
07200 ALTMODE = IFC TENEX THENC ['33] ELSEC
07300 IFC SAILVER THENC ['175] ELSEC ['176] ENDC
07400 ENDC,
07500 TO!ALTMODE!SKIP = [1], TO!LF!APPD = [2],
07600 ONE!CHAR = [3], BREAKER = [4], TO!RUB!ALT!SKIP = [5],
07700 LOCAL!TABLE = [6],
07800 FIML = [256],
07900 ANS(A) = [(S = "A" OR S = "A" + '40)];
08000 DEFINE COMMENT FOR XGP;
08100 USEA= [('177&'14)], USEB= [('177&'15)], VSB= [('177&'20)],
08200 XTAB= [('177&'30)],
08300 XGPNUM(N)= [((N LSH -7) & N)];
08400 DEFINE ESCAPE1= [('177&'1)], ESCAPE2= [('177&'2)];
08500 DEFINE CTLK = [11], CTLF= [6], CTLE= [5], CTLT= ['24], CTLQ= ['21];
08600
08700 IFC SAILVER THENC DEFINE RPGEXT = [".RPG"] ; ENDC
08800
08900 PJ 5/28/74 ; DEFINE
09000 PUIEXT = IFC ITSVER THENC [" PUI"] ELSEC [".PUI"] ENDC,
09100 OCTEXT = IFC ITSVER THENC [" OCT"] ELSEC [".OCT"] ENDC,
09200 TXTEXT = IFC ITSVER THENC [" ASC"] ELSEC [".ASC"] ENDC;
09300
09400 TES 1/7/74 ; DEFINE CTLC= [3], CTLH= ['10], CTLR= ['22], CTLU= ['25], CTLS= ['23] ;
09500 EXTERNAL INTEGER !SKIP! ;
09600 INTEGER BRC, EOF ; COMMENT FOR FONTS TES 10/22/74 ;
09700 INTEGER IML, IMC, comment, no. of lines and chars per page image ;
09800 DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
09900 LFTMAR, comment RASTER left margin (for tabs) ;
10000 RGTMAR, comment RASTER right margin ;
10100 INTRA, comment TES 6/11/74 PARC XGP Intra-line spacing (normally 3) ;
10200 MILLVERTI, RASTVERTI, COMMENT TES 11/2/74 "NORMAL" INTERLINE FOR THIS DOC ;
10300 LISTCHAN, comment output file ;
10400 BAR, TES underlining character (or 0 if OFF) 10/22/73;
10500 PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
10600 I, J, K, L, M, N, DUMMY, comment general-purpose ;
10700 LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
10800 NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
10900 TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
11000 ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
11100 TOPLINE, NCOLS, NLINES, comment Area info ;
11200 COL, LEFTCH, comment Column info ;
11300 SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
11400 NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
11500 NEEDCR, comment, assures CR before every LF for Stanford LPT ;
11600 LINENO, MLEAD, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
11700 ONE, comment, 1 ;
11800 BOTMAR, TOPMAR, RASTPHIGH, RASTPWIDE, RASTLHIGH, comment raster units ;
11900 LINEY, CURRENTX, CURRENTY, DLBP, DLBP1, FSTFONT,
12000 TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;
12100
12200 INTEGER SCRIPT, comment baseline adjustment ;
12300 THISFONT, comment PARC font number for scripts;
12400 SCRLVL; comment baseline level ;
12500
12600 INTEGER TLFTMAR ; TVR temporary left margin in XGP pts;
12700 BOOLEAN MICRO, RASTER ; TES 8/23/74 RASTER = XCRIBL OR MICRO ;
12800 IFC CMUVER THENC BOOLEAN FIRST!OUTPUT ; ENDC RKJ: 10-SEP-74 ;
12900 BOOLEAN NEEDFONTS ; TES 10/17/74 FOR PARC MIC ;
13000 BOOLEAN NEEDVERTI ; TES 11/4/74 ;
13100
13200 INTEGER FLUSHING, FSIZE; comment kludges for XGP ;
13300 EXTERNAL INTEGER RPGSW ;
13400 STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S, SR,
13500 OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
13600 STRING SPSSTR ; COMMENT A STRING OF 200 SPACES (TES 8/28/74) ;
13700 TES 1/7/74 ; STRING CMDFILE ;
13800 TES 3/20/74 ; STRING IFILENAME ; INTEGER IFICHAN ;
13900
14000 REAL RATIO ;
14100
14200 INTEGER ARRAY CHARTBL[0:127], XFILL,XINF,SLIDESG,RB,LBD[1:5] ;
14300 INTEGER ARRAY FNTSIZE,FNTCHAN[0:35] ;
14400
14500 STRING ARRAY LBF[1:5] ;
14600
14700 PRELOAD!WITH "", " ", " ", " ", " ", " ", " ",
14800 " ", " ", " ", " " ;
14900 THAFE STRING ARRAY SPSARR[0:10] ;
15000
15100 TES ADDED ALL PARC MIC STUFF ABOUT 8/28/74 : ;
15200
15300 IFCR PARCVER THENC
15400 PARCODES
15500 PARCARRAYS
15600 ENDC
00100 SIMPLE PROCEDURE WARN(STRING MESSG) ;
00200 USERERR(0,1,MESSG) ;
00300
00400 INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
00500 BEGIN "READIN"
00600 INTEGER CH, FLAG ;
00700 CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
00800 LOOKUP(CH, FILENAME, FLAG) ;
00900 IF FLAG THEN WARN("Pass one said to read this file: " &
01000 FILENAME & " but it does not exist") ;
01100 RETURN(CH) ;
01200 END "READIN" ;
01300
01400 INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
01500 IFC TENEX THENC
01600 OPENFILE(FILENAME, "WC") ;
01700 ELSEC
01800 BEGIN "WRITEON"
01900 INTEGER CH ;
02000 CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
02100 AWHILE DO RKJ: 23-JUL-74 - CHECK FOR ENTER FAILURE ;
02200 BEGIN
02300 ENTER(CH, FILENAME, DUMMY←0);
02400 IF NOT DUMMY THEN DONE;
02500 OUTSTR("Cannot ENTER """ & FILENAME & """ Write file: ");
02600 FILENAME←INCHWL;
02700 END;
02800 RETURN(CH);
02900 END "WRITEON" ;
03000 ENDC
03100
03200 IFC TENEX THENC
03300 INTEGER SIMPLE PROCEDURE WRITE16(STRING FILENAME) ;
03400 BEGIN "WRITE16"
03500 INTEGER CH ;
03600 CH ← GTJFN(FILENAME, 1) ;
03700 IF CH<0 THEN WARN("Error in GTJFN of Document file " & FILENAME) ;
03800 OPENF(CH, '200000100000) ;
03900 IF !SKIP! THEN
04000 BEGIN
04100 ERSTR(!SKIP!,0) ;
04200 WARN("Error opening Document file " & FILENAME) ;
04300 END ;
04400 RETURN(CH) ;
04500 END "WRITE16" ;
04600 ENDC
04700
04800 STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
04900 RETURN('177 & OP & (IF OP LEQ '42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
05000 STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
05100 STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
05200 STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
05300 STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
05400 STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
05500 STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
05600 STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
05700 STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
05800
05900 RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
06000 BEGIN "VARBLANK"
06100 IFC CMUXGP THENC
06200 IF N LEQ 0 THEN RETURN(NULL) ELSE
06300 IF N GEQ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
06400 RETURN(VSB&N)
06500 ELSEC IFC SAILXGP THENC
06600 IF N LEQ 0 THEN RETURN(NULL) ELSE
06700 IF N GEQ 64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
06800 RETURN(ESCAPE2&N)
06900 ELSEC IFC PARCVER THENC
07000 RETURN(CTLE&CVS(N)&".")
07100 ENDC ENDC ENDC;
07200 END "VARBLANK";
07300
07400 INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ;
07500 IF N LEQ 10 THEN RETURN(SPSARR[N MAX 0])
07600 ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
07700 ELSE RETURN(SPSSTR[1 TO N]) ;
07800
07900 IFC TENEX THENC
08000 STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
08100 BEGIN
08200 INTEGER DUMMY ;
08300 SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
08400 RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
08500 END ;
08600 ENDC
08700
08800 IFC PARCVER THENC PARCOUT ENDC
08900
09000 STRING SIMPLE PROCEDURE SPARAM ;
09100 BEGIN "SPARAM"
09200 STRING S ;
09300 S ← NULL ;
09400 DO S ← S & INPUT(SEQCHAN, TO!ALTMODE!SKIP) UNTIL SEQBRC = ALTMODE OR SEQEOF ;
09500 RETURN(S) ;
09600 END "SPARAM" ;
09700
09800 INTEGER SIMPLE PROCEDURE IPARAM ; RETURN(CVD(SPARAM)) ;
09900
10000 IFC CMUXGP THENC RKJ: 29-AUG-74;
10100
10200 INTEGER SIMPLE PROCEDURE INDEX2(STRING A,B);
10300 comment returns the location of the first occurance of
10400 the string B in A, 0 if none;
10500 BEGIN "INDEX2"
10600 INTEGER LA, LB;
10700 IF (LB←LENGTH(B))=0 THEN RETURN(1);
10800 IF (LA←LENGTH(A)-LB+1) LEQ 0 THEN RETURN(0);
10900 START!CODE
11000 LABEL L1, L2, OUTT, NEXT;
11100 MOVE 2,A; MOVN 1,LA; ILDB 0,B; SOS 0,LB;
11200 L1: ILDB 3,2; CAME 3,0; NEXT: AOJL 1,L1;
11300 JUMPE 1,OUTT;
11400 MOVE 4,2; MOVE 5,B; MOVE 6,LB;
11500 L2: ILDB 7,4; ILDB '10,5; CAME 7,'10; JRST NEXT; SOJG 6,L2;
11600 ADD 1,LA; AOJ 1,0;
11700 OUTT:
11800 END;
11900 END "INDEX2";
12000
12100 SIMPLE STRING PROCEDURE FIXUP(STRING S);
12200 BEGIN "FIXUP"
12300 INTEGER ALOC,BLOC;
12400 IF NOT XCRIBL THEN RETURN(S) ; RKJ: 28-SEP-74 ;
12500 IF (ALOC←INDEX2(S,USEA))=1 THEN RETURN(S);
12600 IF (BLOC←INDEX2(S,USEB))=1 THEN RETURN(S);
12700 IF ALOC=0 THEN ALOC←BLOC;
12800 IF BLOC=0 THEN BLOC←ALOC;
12900 ALOC←ALOC MIN BLOC;
13000 RETURN(S[ALOC FOR 2]&S[1 TO ALOC-1]&S[ALOC+2 TO ∞]);
13100 END "FIXUP";
13200 ELSEC
13300 DEFINE FIXUP(X)="X";
13400 ENDC
13500
13600 IFC TENEX THENC
13700 SIMPLE PROCEDURE SFBSZ(INTEGER CHAN, SIZE) ;
13800 BEGIN "SFBSZ"
13900 INTEGER K ;
14000 DEFINE JSYS=['104000000000], SFBSZ=[JSYS '46];
14100 K ← CVJFN(CHAN) ;
14200 START!CODE "BYTE16"
14300 MOVE 1,K; MOVE 2,SIZE; SFBSZ ;
14400 END "BYTE16" ;
14500 END "SFBSZ" ;
14600 ENDC
00100 ONE ← 1 ; COMMENT TO FORCE ARRAY TO BE DYNAMIC ;
00200 BEGIN "VARIABLE BOUND ARRAY BLOCK"
00300 THAFE INTEGER ARRAY CW[0:ONE] ;
00400 REQUIRE "DATUM" SOURCE!FILE ;
00500 REQUIRE "FONTS" SOURCE!FILE ;
00600
00700 BOOLEAN SIMPLE PROCEDURE READFONT(INTEGER WHICH) ;
00800 BEGIN
00900 INTEGER CHAN ;
01000 FNTCHAN[WHICH] ← CHAN ←
01100 IFC PARCVER THENC OPENFILE(FNTNAME[WHICH], "RO")
01200 ELSEC READIN(FNTNAME[WHICH], TRUE, BRC, EOF) ENDC ;
01300 IF CHAN<0 THEN WARN("Can not open font file " &
01400 FNTNAME[WHICH] & " in pass two. This is a bug") ; TES 10/18/74 ;
01500 BRC ← FNTFIL[WHICH] ← CREATE(0,127) ; MAKEBE(BRC, CW) ;
01600 FNTSIZE[WHICH] ← PERUSEFONT(WHICH, CHAN) ;
01700 IFC PARCVER THENC RETURN(FNTNUMBER[WHICH]<0) TES 10/17/74 ;
01800 ELSEC RELEASE(CHAN) ENDC ;
01900 END "READFONT" ;
02000
02100 COMMENT I N I T I A L I Z E ;
02200
02300 WCW ← WHATIS(CW) ;
02400
02500 IFC PARCVER THENC
02600 SR ← NULL ;
02700 DUMMY←CVSIX("PUB2 ");
02800 START!CODE
02900 MOVE 1,DUMMY;
03000 '104000000210;
03100 END;
03200
03300 ARRCLR(NILS, 1) ;
03400 ENDC
03500
03600 SPSSTR ← SP ;
03700 FOR I ← 1 THRU 200 DO SPSSTR ← SPSSTR & SP ; TES 8/28/74 ;
03800
03900 SCRIPT ← 10;
04000 IFC TENEX THENC JOBNO ← CVS(GJINF(DUMMY, DUMMY, DUMMY)) ; ENDC TES 10/25/73 ;
04100
04200 IFC PARCVER THENC IML←65; IMC←72; ENDC
04300 IFC SAILVER THENC IML←53; IMC←69; ENDC
04400 IFC ITSVER THENC IML←55; IMC←69; ENDC PJ 5/28/74 ;
04500 IFC CMUVER THENC IML←55; IMC←69; ENDC
04600 IFC ISIVER THENC IML←55; IMC←69; ENDC
04700 PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
04800 SETBREAK(ONE!CHAR, NULL, NULL, "XA") ;
04900 SETBREAK(TO!ALTMODE!SKIP, ALTMODE, NULL, "IS") ;
05000 SETBREAK(TO!LF!APPD, LF, NULL, "IA") ;
05100 SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
05200 SETBREAK(TO!RUB!ALT!SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
05300 IFC TENEX THENC
05400 IF RPGSW THEN
05500 BEGIN
05600 IFICHAN ← READIN(JOBNO & ".PASS2", FALSE, DUMMY, DUMMY) ;
05700 IFILENAME ← INPUT(IFICHAN, TO!ALTMODE!SKIP) ;
05800 RELEASE(IFICHAN) ; TES 6/11/74 ;
05900 END
06000 ELSE BEGIN TES 6/11/74 REVISED ;
06100 OUTSTR("MANUSCRIPT: ") ;
06200 WHILE -1 = (J ←
06300 GTJFNL(NULL, '162000000000, '100000101,
06400 NULL, NULL, NULL, "PUB", NULL, NULL, NULL)) DO
06500 OUTSTR(" ?" & CRLF & "MANUSCRIPT: ") ;
06600 IFILENAME ← JFNS(J, '1000000000) ;
06700 RLJFN(J) ;
06800 END ;
06900 ENDC
07000
07100 OUTSTR("PASS TWO ") ;
07200
07300 SEQCHAN ← READIN(
07400 IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
07500 FALSE, SEQBRC, SEQEOF) ;
07600
07700 TMPFILE ← SPARAM ;
07800 LISTFILE ← SPARAM ;
07900
08000 DEBUG ← IPARAM ;
08100
08200 DEVICE ← IPARAM ;
08300 XCRIBL ← DEVICE=XGP ;
08400 IFC PARCVER THENC
08500 MICRO ← DEVICE=MIC ;
08600 PDIX ← OUTCOUNT ← 0 ;
08700 IF MICRO THEN
08800 BEGIN
08900 DLBP1 ← '041000677777 ; COMMENT BYTE POINTER ;
09000 END ;
09100 ELSEC MICRO ← FALSE ; ENDC ;
09200 RASTER ← MICRO OR XCRIBL ;
09300
09400 DELINT ← SPARAM ;
09500
09600 LOFONT ← IPARAM ; HIFONT ← IPARAM ;
09700 NEEDFONTS ← FALSE ; TES 10/17/74 ;
09800 FOR J ← LOFONT THRU HIFONT DO
09900 IF FULSTR(FNTNAME[J] ← SPARAM) THEN
10000 IF READFONT(J) THEN NEEDFONTS ← TRUE ;
10100 IFC PARCVER THENC
10200 IF MICRO AND NEEDFONTS THEN
10300 BEGIN TES 10/17/74 ;
10400 K ← -1 ;
10500 FOR J ← LOFONT THRU HIFONT DO IF FULSTR(FNTNAME[J]) THEN
10600 FNTNUMBER[J] ← K ← K + 1 ;
10700 END ;
10800 ENDC
10900
11000 CMDFILE ← SPARAM ;
11100
11200 BAR ← SPARAM[1 FOR 1] ;
11300 IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;
11400
11500 CHARW ← IPARAM;
11600 NEEDVERTI ← FALSE ;
11700 IF (MILLVERTI←IPARAM) LEQ 0 THEN
11800 BEGIN
11900 INTRA ← IFC NOT SAILXGP THENC 0 ; BH 11/19/74 ; ENDC
12000 MILLVERTI ← ABS(MILLVERTI) ;
12100 NEEDVERTI ← RASTER ;
12200 END
12300 ELSE INTRA ← MILLVERTI ;
12400 BASELINE ← IPARAM; BASELINE←BASELINE+(BASELINE DIV 4);
12500 DOPASS3 ← IPARAM; RKJ: 1-4-74;
12600 IFC CMUVER THENC FIRST!OUTPUT ← NOT DOPASS3 ; ENDC RKJ: 28-SEP-74 ;
12700 VBPI ← IPARAM ;
12800 HBPI ← IPARAM ;
12900 MINLFTMAR ← IPARAM ;
13000
13100 INTRA ← (INTRA*VBPI + 500)/1000 ; TES 11/2/74 ;
13200 RASTVERTI ← (MILLVERTI*VBPI + 500)/1000 ; TES 11/2/74 ;
13300
13400
13500 IF NOT RPGSW AND NOT RASTER THEN COMMENT STARTED BY ".R PUB2" ;
13600 DO BEGIN
13700 OUTSTR("OUTPUT DEVICE (LPT or TTY): ") ;
13800 S ← INCHWL ;
13900 DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE 0 ;
14000 END
14100 UNTIL DEVICE ;
14200 IF NOT RPGSW AND DEBUG THEN
14300 IF DEVICE = MIC THEN DEBUG ← 0
14400 ELSE DO BEGIN
14500 OUTSTR("Debug info in right margin? (Y or N) = ") ;
14600 S ← INCHWL ;
14700 DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
14800 END
14900 UNTIL DEBUG < 100 ;
15000
15100 ENDLINE ← LF ; ENDPAGE ← FF ;
15200 IFC PARCVER THENC IF MICRO THEN ENDLINE ← MEOL ; ENDC
15300 RESTARTLINE ←
15400 IFC PARCVER THENC IF XCRIBL THEN CTLT&"0." ELSE CR
15500 ELSEC CR ENDC ; TES 11/1/73 ;
15600
15700 IFC SAILVER THENC
15800 CASE DEVICE-1 OF
15900 BEGIN "DEV"
16000 comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
16100 comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
16200 comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
16300 IF DEBUG THEN BEGIN OUTSTR(CRLF&"Won't put Debug info on Microfilm"&CRLF) ;
16400 DEBUG ← FALSE ; END END ;
16500 COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
16600 END "DEV" ;
16700 ELSEC
16800 IFC PARCVER THENC
16900 IF MICRO THEN LISTCHAN ← WRITE16(LISTFILE) ELSE
17000 ENDC
17100 LISTCHAN ← WRITEON(LISTFILE) ;
17200 ENDC
17300 IFC TENEX THENC LISTFILE ← JFNS(LISTCHAN, 0) ; ENDC
17400 OUTSTR(LISTFILE) ;
17500
17600 J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
17700
17800 LABCHAN ← READIN(
17900 IFC TENEX THENC IFILENAME&".LABELS" ELSEC "PULABL"&PUIEXT ENDC,
18000 FALSE, LABBRC, LABEOF) ;
18100 NL ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ;
18200
18300 LASL ← 1000 ; comment, last physical line occupied on the page ;
18400
18500 S←INPUT(SEQCHAN,TO!LF!APPD); comment get to right place ;
18600
18700 TES 1/7/74 ADDED : TES 6/11/74 WITH INTRA:;
18800 IFC PARCVER THENC
18900 IF XCRIBL THEN OUT(LISTCHAN,
19000 (RUBOUT&CTLC) & CMDFILE &
19100 ("K EFHJKLMQRSTU" & CR & "I " & CVS(INTRA) &
19200 CR & "M 0" & CR & "W 1600" & CR & "E" & CR)) ;
19300 COMMENT
19400 CTLC Initiallize switches (used as RUBOUT CTLC)
19500 CTLE Variable blank
19600 CTLF Font change
19700 CTLH Overstrike
19800 CTLJ=LF Line Feed
19900 CTLK Vertical Spacing
20000 CTLL=FF Form Feed
20100 CTLM=CR Carriage Return
20200 CTLQ Quote control character
20300 CTLR Return to baseline from ript
20400 CTLS Subscript
20500 CTLT Tab
20600 CTLU Superscript
20700 RUBOUT Treat as control character (inverse CTLQ)
20800 ;
20900 ENDC
21000
21100 IFC SAILVER THENC
21200 IF XCRIBL THEN
21300 OUT(LISTCHAN,"/LMAR="&CVS(LFTMAR)&"/XLINE="&CVS(INTRA)&CMDFILE&CRLF&FF) ;
21400 ENDC
21500 IFC ITSVER THENC PJ 8/24/74 ;
21600 IF XCRIBL THEN OUT(LISTCHAN,";LFTMAR "&CVS(LFTMAR)&CRLF&
21700 ";VSP "&CVS(INTRA)&CRLF&
21800 ";SKIP 1"&CRLF&
21900 CMDFILE&CRLF&FF);
22000 ENDC
00100 BEGIN "INNER BLOCK"
00200
00300 STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
00400
00500 AWHILE DO
00600 BEGIN "LABEL"
00700 TABLE ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ; IF LABEOF THEN DONE ;
00800 LABTAB[TABLE, CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP))] ←
00900 INPUT(LABCHAN, TO!ALTMODE!SKIP) &
01000 (IF RASTER THEN
01100 (ALTMODE & INPUT(LABCHAN, TO!ALTMODE!SKIP))
01200 ELSE NULL);
01300 END "LABEL" ;
01400
01500 RELEASE(LABCHAN);
01600
01700 COMMENT G O ! ;
01800
01900 IF MICRO THEN IML ← 1 ; COMMENT SAVE STORAGE ;
02000 DO comment, This loop is re-entered only if page image grows ;
02100
02200 BEGIN "SIZE"
02300 THAFE STRING ARRAY IMG[1:IML+IML], SEG[0:8*IMC], SRCREF[1:IML] ;
02400 THAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML], LEADING[1:IML+1] ;
02500 LABEL CONTINUE ;
02600
02700 COMMENT * * * * A P P D * * * * ;
02800
02900 INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
03000 IFC PARCVER THENC PARCAPPD ENDC
03100 BEGIN "APPD"
03200 INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
03300 L ← LINE ; EXTRA ← LENGTH(S) ;
03400 IF XCRIBL THEN
03500 BEGIN TES 11/13/73 FOR MULTI-COLUMNS ;
03600 IF CHAR < (HAD ← LASC[L]) THEN
03700 BEGIN
03800 FAKE[L] ← FAKE[L] + HAD - CHAR ;
03900 HAD ← LASC[L] ← CHAR ;
04000 END
04100 END
04200 ELSE
04300 WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
04400 IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN
04500 WARN("Too much for one page: " & S)
04600 ELSE L ← AVAIL ;
04700 SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
04800 T ← IMG[L] ;
04900 IF LENGTH(T) < HAD+SPACES+EXTRA THEN
05000 BEGIN comment no room -- must use concatenate ;
05100 SS ← SPS(SPACES) ;
05200 IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
05300 IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞]
05400 END
05500 ELSE BEGIN comment there's room in old string -- IDPB into it.;
05600 SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
05700 START!CODE "APPEND" LABEL LOOP1, LOOP2 ;
05800 MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
05900 MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
06000 LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
06100 END "APPEND" ;
06200 END ;
06300 RETURN(LASC[L] ← CHAR + EXTRA) ;
06400 END "APPD" ;
06500
06600 COMMENT * * * * C T R L * * * * ;
06700
06800 SIMPLE PROCEDURE CTRL(STRING S) ;
06900 BEGIN "CTRL"
07000 CHAR ← 0 MAX APPD(S) - LENGTH(S) ;
07100 LASC[L] ← CHAR ;
07200 FAKE[L] ← FAKE[L] + LENGTH(S) ;
07300 END "CTRL" ;
07400
07500 SIMPLE PROCEDURE MCTRL(INTEGER C) ;
07600 BEGIN "MCTRL"
07700 QUICK!CODE "MCTRLAPPEND"
07800 LABEL RBYTE ;
07900 DEFINE WD=['13] ;
08000 MOVE WD, C ;
08100 CAIG WD,'377 ;
08200 JRST RBYTE ;
08300 ROT WD, -8 ;
08400 IDPB WD, DLBP ;
08500 ROT WD, 8 ;
08600 RBYTE:
08700 IDPB WD, DLBP ;
08800 END "MCTRLAPPEND" ;
08900 END "MCTRL" ;
00100 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
00200 BEGIN "UNDERSCORE"
00300 INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
00400 NUMCHARS ← RIGHTCHAR - UNDERLINE ;
00500 IF NUMCHARS > 0 THEN
00600 BEGIN
00700 SAVEHORIZ ← CHORIZ ;
00800 DESCEND ← CCSIZE DIV 4 ;
00900 CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
01000 SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
01100 DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
01200 UNDERLINE ← RIGHTCHAR ;
01300 END ;
01400 END "UNDERSCORE" ;
01500
01600 SIMPLE PROCEDURE CHANGESPACING ;
01700 IF (N←CHRS-CHAR-1)>0 AND (K←(J←N*CHORIZ+SHORTM)/N MIN 511) NEQ CHORIZ THEN
01800 BEGIN "CHANGESPACING"
01900 IF UNDERLINE GEQ 0 THEN UNDERSCORE(CHAR) ;
02000 SHORTM ← J - K*N ;
02100 IF NOTFST AND (UNDERLINE<0 OR SHORTM<0) THEN
02200 BEGIN CTRL(DORDOTS(SHORTM)) ; SHORTM ← 0 END ; TES CTRL 8/28/74;
02300 CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
02400 END "CHANGESPACING" ;
02500
02600 SIMPLE PROCEDURE FONTSELECT(INTEGER WHICH);
02700 BEGIN "FONTSELECT"
02800 IF (WHICH←WHICH-"0")>9 THEN WHICH←WHICH-("A"-"0"-10);
02900 THISFONT ← WHICH ; TES 10/17/74 ;
03000 IFC CMUXGP THENC
03100 WHICH←WHICH MOD 9; COMMENT MAKE 1,A 2,B EQUIVALENT;
03200 IF WHICH=1 THEN CTRL(USEA) ELSE
03300 IF WHICH=2 THEN CTRL(USEB) ELSE
03400 WARN("Font " & CVS(WHICH) & " ignored")
03500 ELSEC IFC SAILXGP THENC
03600 IF WHICH>16 THEN WARN("Font " & CVS(WHICH) & " ignored") ELSE
03700 BEGIN
03800 CTRL(ESCAPE1&(WHICH-1));
03900 IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
04000 END;
04100 ELSEC IFC PARCVER THENC
04200 PARCFONT
04300 ENDC ENDC ENDC;
04400 END "FONTSELECT";
04500
04600 STRING SIMPLE PROCEDURE XTABSTR(INTEGER N); RKJ: NEW 1-4-74;
04700 BEGIN "XTABSTR"
04800 IFC CMUXGP THENC RETURN(XTAB&XGPNUM(N)) ENDC
04900 IFC SAILXGP THENC
05000 RETURN(ESCAPE1&'40&XGPNUM(N))
05100 ENDC
05200 IFC PARCVER THENC
05300 RETURN(CTLT&CVS(N)&".")
05400 ENDC;
05500 END "XTABSTR";
05600
05700 SIMPLE PROCEDURE XGPTAB(INTEGER N); RKJ: NEW 1-4-74;
05800 CTRL(XTABSTR(N+TLFTMAR));
05900
06000 STRING PROCEDURE SCNBYCOUNT(INTEGER COUNT) ;
06100 BEGIN
06200 INTEGER I ; STRING S ;
06300 S ← NULL ;
06400 FOR I ← 1 THRU COUNT DO S ← S & SCN(ONE!CHAR) ;
06500 RETURN(S) ;
06600 END ;
06700
06800 SIMPLE STRING PROCEDURE UNMASH(STRING Q) ;
06900 BEGIN TES 8/14/74 PACK EXCESS-64 4-BIT BYTES INTO 7-BIT BYTES ;
07000 STRING S ; S ← NULL ;
07100 WHILE FULSTR(Q) DO S ← S & (((LOP(Q)-64)LSH 4) + (LOP(Q)-64)) ;
07200 RETURN(S) ;
07300 END ;
07400
07500 SIMPLE INTEGER PROCEDURE BYTECOUNT(INTEGER BPNOW, BPTHEN) ;
07600 RETURN(
07700 ((RH(BPNOW)-RH(BPTHEN)) LSH 2) + ((28-((BPNOW ROT 6) LAND '77)) LSH -3) - 3
07800 ) ;
07900
08000 IFC PARCVER THENC PARCLINE ENDC
08100
08200 SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ;
08300 BEGIN "IMPOSSIBLE"
08400 IF SG > -1 THEN
08500 BEGIN
08600 OUTSTR(CRLF & HOW & " Error."&CRLF&
08700 "This is an encoding of text line " & CVS(LINE) & ":" & CRLF) ;
08800 FOR I ← 1 THRU SG DO OUTSTR(SEG[I]) ;
08900 END ;
09000 WARN("A supposedly impossible condition has been encountered."&CRLF&
09100 "This is most likely a PUB bug. However, you may have an error"&CRLF&
09200 "which produced unanticipated line lengths or other strange effects."&
09300 (IF DEBUG THEN CRLF&"Line/Page: "&SRCREF[LINE] ELSE NULL)) ;
09400 END "IMPOSSIBLE" ;
00100 SIMPLE PROCEDURE SLIDERROR ;
00200 BEGIN
00300 IMPOSSIBLE(CVS(SLIDETOP)&" Horizontal Positioning") ;
00400 SLIDETOP ← 1 ;
00500 END ;
00600
00700 SIMPLE PROCEDURE RIGHTBOUND ;
00800 BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
00900 INTEGER DEST, FILLIN, I ; STRING FILLER, OLBF ;
01000 INTEGER XF; STRING XTO ; TES 3/30/74;
01100 IF SLIDETOP < 1 THEN SLIDERROR ;
01200 IF LBD[SLIDETOP] < -900 THEN COMMENT FLUSH RIGHT ;
01300 BEGIN
01400 IF RASTER THEN
01500 BEGIN
01600 XF←RB[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE);
01700 XTO ← "=" ;
01800 END ;
01900 FILLIN←RB[SLIDETOP]-CHRS;
02000 END
02100 ELSE COMMENT CENTER ;
02200 BEGIN
02300 IF RASTER THEN
02400 BEGIN
02500 XF ← (RB[SLIDETOP]-LBD[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE)) DIV 2;
02600 XTO ← "+" ;
02700 END ;
02800 FILLIN ← ((RB[SLIDETOP]-CHRS) DIV 2) MAX 0;
02900 END;
03000 DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
03100 IF FULSTR(OLBF) THEN
03200 IF RASTER THEN
03300 BEGIN "XGPINFINITY"
03400 FILLER ← NULL ;
03500 FOR I ← 1 THRU XINF[SLIDETOP] DO FILLER ← FILLER & OLBF ;
03600 SEG[I ← SLIDESG[SLIDETOP]] ← FILLER ;
03700 SEG[I + 1] ← RUBOUT & XTO & CVS(XF) ;
03800 END "XGPINFINITY"
03900 ELSE
04000 BEGIN "NON-BLANKS"
04100 FILLER ← NULL ;
04200 WHILE CHRS < DEST DO
04300 BEGIN
04400 FILLER ← FILLER & OLBF ;
04500 CHRS ← CHRS + LENGTH(OLBF) ;
04600 END ;
04700 IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
04800 SEG[SLIDESG[SLIDETOP]] ← FILLER ;
04900 END "NON-BLANKS"
05000 ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT &
05100 (IF RASTER THEN (XTO&CVS(XF))
05200 ELSE ("+"&CVS(FILLIN)) );
05300 CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
05400 BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
05500 FLUSHING ← FALSE ; FSIZE ← 0 ;
05600 END "RIGHTBOUND";
05700
05800 SIMPLE INTEGER PROCEDURE STEP!SG ;
05900 IF SG<8*IMC THEN RETURN(SG←SG+1)
06000 ELSE BEGIN
06100 IMPOSSIBLE("Line complexity") ;
06200 RETURN(SG←0) ;
06300 END ;
00100 IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
00200 AWHILE DO
00300 BEGIN "FILE"
00400 PAGEFILE ← SPARAM ; IF SEQEOF THEN DONE ;
00500 IFC TENEX THENC
00600 IFILE ← IFILENAME & OCTEXT & PAGEFILE ;
00700 SFILE ← IFILENAME & TXTEXT & PAGEFILE ;
00800 ELSEC
00900 IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
01000 ENDC
01100 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
01200
01300 AWHILE DO
01400 BEGIN "PAGE"
01500 PAGEHIGH ← INNUM ; IF PAGEEOF OR PAGEHIGH LEQ 0 THEN DONE ; PAGEWIDE ← INNUM ;
01600 LFTMAR ← 0 MAX (INNUM*HBPI + 500)/1000 - MINLFTMAR ; TES 6/11/74 ADDED ;
01700 RGTMAR ← 0 MAX ((8500-INNUM)*HBPI + 500)/1000 - MINLFTMAR ; TES 8/29/74 ADDED ;
01800 COMMENT HBPI HORIZ BITS PER INCH, MINLFTMAR BIT MIN MARGIN;
01900 IF NOT MICRO AND (PAGEHIGH > IML OR PAGEWIDE > IMC) THEN
02000 BEGIN "EXPAND"
02100 IFC SAILVER THENC
02200 IF DEVICE=MIC THEN
02300 BEGIN "FRAME SIZE"
02400 IF LASL NEQ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
02500 NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
02600 NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
02700 OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
02800 END "FRAME SIZE"
02900 ELSE IF DEVICE = LPT THEN
03000 BEGIN
03100 IF (LASL-1) MOD 66 + 1 LEQ 6 AND (PAGEHIGH-1) MOD 66 < 60 THEN
03200 OUT(LISTCHAN, ENDPAGE) ;
03300 ENDLINE ← IF PAGEHIGH GEQ 54 THEN RUBOUT & '21 ELSE LF ;
03400 END ;
03500 ENDC;
03600 IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
03700 DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
03800 END "EXPAND" ;
03900
04000 CONTINUE: OUTSTR(SP & CVS(PAGECT ← PAGECT + 1)) ; AVAIL ← IML ;
04100 TOPMAR ← BOTMAR ← VBPI ; COMMENT *** TEMP VALUE -- 1" ;
04200 RASTPHIGH ← 11*VBPI - (TOPMAR+BOTMAR) ; COMMENT *** TEMP *** ;
04300 RASTPWIDE ← (17*HBPI)/2 - (LFTMAR+RGTMAR) ; COMMENT *** TEMP *** ;
04400 RASTLHIGH ← RASTPHIGH/PAGEHIGH ;
04500 IFC SAILVER THENC
04600 IF PAGECT > 1 THEN
04700 IF DEVICE = LPT THEN COMMENT AVOID SPURIOUS BLANK PAGE ;
04800 IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
04900 ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
05000 BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END
05100 ELSE OUT(LISTCHAN, ENDPAGE) ;
05200 ENDC
05300 IFC CMUXGP THENC
05400 IF PAGECT>1 THEN OUT(LISTCHAN,ENDPAGE);
05500 ENDC
05600
05700 IFC PARCVER THENC
05800 IF MICRO THEN
05900 BEGIN
06000 FSTFONT ← -1 ;
06100 DLBP ← DLBP1 ;
06200 TLIX ← 0 ;
06300 END ;
06400 ENDC
00100 WHILE (TOPLINE ← INNUM) > -10 DO
00200 BEGIN "AREA"
00300 NCOLS ← INNUM ; NLINES ← INNUM ;
00400 FOR COL ← 1 THRU NCOLS DO
00500 BEGIN "COLUMN"
00600 LEFTCH ← INNUM ;
00700 TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ; TVR: Initiallize left margin for this column ;
00800 WHILE (LINENO ← INNUM) DO
00900 BEGIN "LINE"
01000 SH ← SHORTM ← INNUM ;
01100 MLEAD ← INNUM ; TES 11/2/74 ;
01200 SG ← FSTBRK ← -1 ;
01300 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
01400 LINE ← TOPLINE - 1 + LINENO ;
01500 IF LINE<1 OR LINE>PAGEHIGH THEN
01600 BEGIN
01700 WARN("Area outside page. If Pass one didn't tell you too, then there is a bug in PUB");
01800 LINE←LINE MAX 1 MIN PAGEHIGH ;
01900 END ;
02000 L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
02100 IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
02200 ELSE BEGIN FROMFILE ← TRUE ;
02300 WHILE L NEQ (M←CVD(INPUT(SCHAN, TO!ALTMODE!SKIP))) DO
02400 BEGIN S ← NULL ;
02500 RKJ: 4-26-74, added EOF stuff on next two lines ;
02600 DO S ← S & INPUT(SCHAN, TO!LF!APPD) UNTIL PAGEBRC = LF OR PAGEEOF ;
02700 IF PAGEEOF THEN USERERR(0,0,"Bad input from Pass One (a PUB bug), I give up.");
02800 OWLS[M MOD FIML] ← S ;
02900 END ;
03000 END ;
03100 IF NOT DEBUG THEN S ← SCN(TO!ALTMODE!SKIP)
03200 ELSE BEGIN
03300 SR ← IF MICRO THEN NULL ELSE SRCREF[LINE] ;
03400 SR ← SR & " " & SCN(TO!RUB!ALT!SKIP) ;
03500 WHILE PAGEBRC NEQ ALTMODE DO
03600 BEGIN "ERROR MESSG"
03700 S ← SCN(TO!RUB!ALT!SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
03800 IF DEVICE=TTY OR (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SR)+M LEQ 119 THEN
03900 SR ← SR & "..." & S ;
04000 END "ERROR MESSG" ;
04100 IF NOT MICRO THEN SRCREF[LINE] ← SR ;
04200 END ;
04300 DO BEGIN "PIECE"
04400 S ← SCN(BREAKER) ; TES 11/6/74 ;
04500 WHILE NOT PAGEEOF AND NOT PAGEBRC DO
04600 S ← S & SCN(BREAKER) ; TES 11/6/74 ;
04700 CHRS ← CHRS + LENGTH(SEG[STEP!SG] ← S) ;
00100 CASE CHARTBL[PAGEBRC] OF
00200 BEGIN comment by BRC ;
00300
00400 comment 0 ... ; IMPOSSIBLE("0"&CVOS(PAGEBRC)&" Break Character") ;
00500
00600 comment 1 ... RUBOUT -- Font change ; BEGIN
00700 SEG[STEP!SG] ← RUBOUT & (F←SCN(ONE!CHAR)) &
00800 (S ← IF F="-" OR F="+" OR F="=" THEN SCN(TO!ALTMODE!SKIP)
00900 ELSE IF F = "F" THEN SCN(ONE!CHAR)
01000 ELSE IF F="π" THEN SCNBYCOUNT(SCN(ONE!CHAR))
01100 ELSE NULL) ;
01200 IF F = "π" THEN CHRS ← CHRS + 1
01300 ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
01400 ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
01500 ELSE IF F = "→" THEN
01600 BEGIN COMMENT ∞ ;
01700 IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN SLIDERROR ;
01800 SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
01900 LBD[SLIDETOP] ← SCNUM ;
02000 IF RASTER THEN
02100 BEGIN
02200 RKJ; XFILL[SLIDETOP] ← SCNUM ;
02300 TES ; XINF[SLIDETOP] ← SCNUM ;
02400 END ;
02500 LBF[SLIDETOP] ← SCN(TO!ALTMODE!SKIP) ;
02600 IF RASTER AND FULSTR(LBF[SLIDETOP]) THEN STEP!SG ; RKJ: 1-9-74;
02700 FLUSHING ← TRUE;
02800 END
02900 ELSE IF F = "←" THEN
03000 RIGHTBOUND
03100 ELSE IF F = "=" THEN BEGIN
03200 comment 8/9/73 RKJ IF RASTER THEN SHORTM←(SHORTM-BRKS*CHARW) MAX 0;
03300 BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
03400 END ; COMMENT NOJUST LEFT OF TAB ;
03500
03600 comment 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[STEP!SG] ← ALTMODE END ;
03700
03800 comment 3 ... VT -- label reference ;
03900 BEGIN "LABEL REF"
04000 STRING S;
04100 S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
04200 L ← LENGTH(SEG[STEP!SG] ← SCAN(S, TO!ALTMODE!SKIP, DUMMY)) ;
04300 J ← CVD(S) ;
04400 SHORTM ← SHORTM - (IF RASTER THEN J ELSE L) ; CHRS ← CHRS + L ;
04500 IF FLUSHING AND RASTER THEN FSIZE←FSIZE+J ;
04600 END "LABEL REF" ;
00100 comment 4 ... CR -- Justify it ;
00200 BEGIN "JUSTIFY"
00300 WHILE SLIDETOP DO BEGIN SLIDERROR ; RIGHTBOUND END ;
00400 IF SHORTM < 0 THEN SHORTM ← 0 ;
00500 IFC SAILVER THENC IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ ELSE ENDC
00600 BEGIN "DISTRIBUTE SPACES"
00700 COMMENT beta(α,K) = [α(K+1)] - [αK], PJ 5/27/74 ITS doesn't like <control-C>'s
00800 WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
00900 RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
01000 END "DISTRIBUTE SPACES" ;
01100 UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN PAGEHIGH ; CHAR ← 0 MAX LEFTCH-1 MAX 0 ;
01200 IFC CMUVER THENC IF XCRIBL THEN CHAR←LASC[LINE]; ENDC RKJ: 7-Nov-74, needed for multi column;
01300 NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
01400
01500 TVR: Initial column select for XGP ;
01600 IF XCRIBL AND (LEFTCH NEQ 1 OR LFTMAR > 0) THEN XGPTAB(0) ;
01700 IFC PARCVER THENC IF MICRO THEN OPENLINE(0, -1) ; ENDC
01800
01900 IF XCRIBL THEN LEADING[LINE] ← TES 11/4/74; RKJ: 7-Nov-74;
02000 IF MLEAD = 0 THEN 0
02100 ELSE IF MLEAD > 0 THEN (MLEAD*VBPI + 500)/1000
02200 ELSE -((-MLEAD*VBPI + 500)/1000) ;
02300
02400 IFC SAILVER THENC
02500 IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
02600 ENDC
02700 FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
02800 BEGIN comment three cases ;
02900
03000 comment 0 ... text ;
03100 BEGIN "TEXT SEG"
03200 IF UNDERLINE<0 OR BAR=0 TES 10/22/73 ; THEN CHAR ← 0 MAX APPD(S) ELSE
03300 COMMENT *** UNDERLINING *** ;
03400 IF DEVICE = MIC THEN
03500 IFC SAILVER THENC
03600 BEGIN K ← LENGTH(S) ;
03700 WHILE K DO
03800 BEGIN COMMENT DON'T UNDERLINE BLANKS ;
03900 N ← LOP(S) ;
04000 IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
04100 K ← K - 1 ;
04200 END ;
04300 END
04400 ENDC
04500 IFC PARCVER THENC PARCBAR ENDC
04600 ELSE IF XCRIBL THEN
04700 BEGIN
04800 IFC CMUXGP THENC
04900 K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
05000 START!CODE "XGPUNDER"
05100 DEFINE LEN= [2],SRC= [3],DEST= [4],RUB= [5],ESC= [6],R= [7],CNT= ['10],UBAR= ['11];
05200 LABEL LOOP,ELOOP,SPACE,OUTT;
05300 SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVE UBAR,BAR;
05400 LOOP: ILDB R,SRC;
05500 CAIE R,BAR; CAIN R,SP; JRST SPACE;
05600 IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
05700 ELOOP: SOJG LEN,LOOP;
05800 MOVEM CNT,N; JRST OUTT;
05900 SPACE: IDPB R,DEST;
06000 AOJA CNT,ELOOP;
06100 OUTT:
06200 END "XGPUNDER";
06300 CHAR ← 0 MAX APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
06400 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
06500 ENDC
06600 IFC SAILXGP THENC CHAR ← 0 MAX APPD(S); ENDC
06700 IFC PARCVER THENC
06800 K←LENGTH(S); SS←0&SPS(K*3); N←LOP(SS);
06900 START!CODE "XGPUNDER"
07000 DEFINE LEN= [2],SRC= [3],DEST= [4],BS= [5],UBAR= [6],CNT= [7],R= ['10];
07100 LABEL LOOP, OUTT, NOBAR; TES 8/19/74 TES CHAR BS BAR -> BAR BS CHAR, FOR BOBROW ;
07200 SETZ CNT,0;
07300 MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI BS,'10; MOVE UBAR,BAR;
07400 LOOP: SOJL LEN,OUTT;
07500 ILDB R,SRC;
07600 CAIE R,BAR; CAIN R,SP; AOJA CNT,NOBAR;
07700 IDPB UBAR,DEST; IDPB BS,DEST;
07800 NOBAR: IDPB R,DEST;
07900 JUMPA LOOP;
08000 OUTT: MOVEM CNT,N;
08100 END "XGPUNDER";
08200 CHAR ← 0 MAX APPD(SS[1 TO (K*3-N*2)])-(K-N)*2;
08300 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*2;
08400 ENDC
08500 END
00100 ELSE BEGIN CHAR ← 0 MAX APPD(S);
00200 K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR ← 0 MAX CHAR-K ;
00300 IFC NOT CMUXGP THENC RKJ: 1-7-74;
00400 START!CODE "UNDER" LABEL LOOP ;
00500 MOVE 2, K ; MOVE 3, SS ;
00600 LOOP: ILDB 4,3 ; CAIE 4,SP ; CAIN 4,BAR ; CAIA 0,0 ; MOVE 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
00700 END "UNDER" ; CHAR ← 0 MAX APPD(SS[1 TO LENGTH(S)]) ;
00800 ELSEC CHAR ← 0 MAX APPD(S); ENDC RKJ: 1-7-74;
00900 END ;
01000 END "TEXT SEG" ;
01100
01200 comment 1 ... RUBOUT -- Font Change ;
01300 IF (F←S[2 FOR 1])="↑" THEN
01400 IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE ENDC
01500 IFC PARCVER THENC
01600 IF MICRO THEN PARCSUPER ELSE
01700 IF XCRIBL THEN
01800 IF (SCRLVL←SCRLVL+SCRIPT) LEQ 0 THEN CTRL("R"-'100) ELSE
01900 BEGIN LABEL L1;
02000 CTRL("U"-'100);
02100 L1:
02200 IF G<SG THEN
02300 BEGIN
02400 SS←SEG[G+1];
02500 IF NULSTR(SS) THEN BEGIN G←G+1; GO L1 END; comment try again ;
02600 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
02700 BEGIN
02800 G←G+1;
02900 CTRL(SS[3 FOR 1]);
03000 END ELSE CTRL(THISFONT+"0");
03100 END ELSE CTRL(THISFONT+"0")
03200 END
03300 ELSE ENDC
03400 IFC SAILXGP THENC
03500 IF XCRIBL THEN
03600 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
03700 ELSE ENDC LINE←LINE-1 MAX 1
03800 ELSE IF F = "↓" THEN
03900 IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE ENDC
04000 IFC PARCVER THENC
04100 IF MICRO THEN PARCSUB ELSE
04200 IF XCRIBL THEN
04300 IF (SCRLVL←SCRLVL-SCRIPT) GEQ 0 THEN CTRL("R"-'100) ELSE
04400 BEGIN LABEL L2;
04500 CTRL("S"-'100);
04600 L2:
04700 IF G<SG THEN
04800 BEGIN
04900 SS←SEG[G+1];
05000 IF NULSTR(SS) THEN BEGIN G←G+1; GO L2 END; comment ↑↑↑ ;
05100 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
05200 BEGIN
05300 G←G+1;
05400 CTRL(SS[3 FOR 1]);
05500 END ELSE CTRL(THISFONT+"0");
05600 END ELSE CTRL(THISFONT+"0")
05700 END
05800 ELSE ENDC
05900 IFC SAILXGP THENC
06000 IF XCRIBL THEN
06100 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
06200 ELSE IF F = "_" THEN
06300 BEGIN
06400 UNDERLINE ← CHAR;
06500 IFC SAILVER THENC
06600 IF XCRIBL THEN CTRL(ESCAPE1&'46);
06700 ENDC
06800 IFC ITSVER PJ 8/23/74 ; THENC
06900 IF XCRIBL THEN BEGIN CTRL(ESCAPE1&'46); CTRL(ESCAPE1&'46) END;
07000 ENDC
07100 END
07200 ELSE IF F = "≡" THEN
07300 BEGIN "END UNDERLINED TEXT"
07400 IFC SAILVER THENC
07500 IF DEVICE = MIC AND BAR TES 10/22/73; THEN UNDERSCORE(CHAR) ;
07600 ENDC
07700 UNDERLINE ← -1 ;
07800 IFC SAILVER THENC
07900 IF XCRIBL AND BAR TES 10/22/73; THEN
08000 CTRL(ESCAPE1&'51&2&3); BH 12/3/74 DOUBLE THICK UNDERLINE ;
08100 ENDC
08200 IFC ITSVER THENC PJ 8/23/74 ;
08300 IF XCRIBL AND BAR THEN BEGIN CTRL(ESCAPE1&'47&3); CTRL(ESCAPE1&'47&4) END;
08400 ENDC
08500 END "END UNDERLINED TEXT"
08600 ELSE IF F="-" THEN
08700 BEGIN
08800 F ← CVD(S[3 TO ∞]) ;
08900 IF DEVICE=MIC THEN
09000 IFC SAILVER THENC
09100 CTRL(DOLSPCS(F))
09200 ENDC
09300 IFC PARCVER THENC
09400 PARCLEFT
09500 ENDC
09600 ELSE CHAR←CHAR-F MAX 0
09700 END
09800 ELSE IF F="*" THEN CHAR ← 0 MAX LASC[LINE] comment not always correct! ;
09900 ELSE IF F="+" THEN
10000 BEGIN F ← CVD(S[3 TO ∞]) ;
10100 IFC SAILVER THENC
10200 IF DEVICE=MIC THEN CTRL(DORSPCS(F)) ELSE
10300 ENDC
10400 IFC PARCVER THENC
10500 PARCRIGHT
10600 ENDC
10700 IF XCRIBL THEN CTRL(VARBLANK(F))
10800 ELSE CHAR←CHAR+F MIN IMC
10900 END
11000 ELSE IF F="=" THEN
11100 BEGIN "TAB"
11200 F ← CVD(S[3 TO ∞]) ;
11300 IF NOT RASTER THEN F ← (F MAX 0) + LEFTCH - 1 MIN IMC ; TES 8/17/74 FIX BUG ;
11400 IF XCRIBL THEN XGPTAB(F)
11500 ELSE IF DEVICE NEQ MIC THEN CHAR ← F
11600 IFC SAILVER THENC
11700 ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
11800 ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
11900 ENDC
12000 IFC PARCVER THENC PARCTAB ENDC
12100 END "TAB"
12200 ELSE IF F = "π" THEN
12300 BEGIN TES 11/29/73 REWROTE ; TES 11/4/74 ADDED SPECIAL ;
12400 BOOLEAN SPECIAL ;
12500 IFC CMUXGP THENC
12600 IF UNDERLINE GEQ 0 AND BAR THEN CTRL(RUBOUT&'35) ;
12700 ENDC TES 12/13/73 ;
12800 SPECIAL ← S[3 FOR 1] = 63 ;
12900 SS ← UNMASH(S[(IF SPECIAL THEN 4 ELSE 3) TO ∞]) ;
13000 IFC PARCVER THENC
13100 IF XCRIBL THEN SS←CTLQ&SS ;
13200 IF MICRO THEN PARCPICHAR
13300 ELSE
13400 ENDC
13500 BEGIN
13600 F ← LENGTH(SS)-1 ; CHAR ← 0 MAX APPD(SS)-F ;
13700 LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + F ;
13800 IF UNDERLINE GEQ 0 AND BAR AND DEVICE NEQ MIC
13900 IFC SAILXGP THENC AND NOT XCRIBL ENDC
14000 THEN CTRL(IFC PARCVER THENC '10& ENDC BAR) ; TES 12/13/73;
14100 END ;
14200 END
14300 ELSE IF F = "←" THEN BEGIN END
00100 ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
00200 ELSE IF F='35 THEN COMMENT OVERSTRIKE NEXT CHAR OVER LAST ;
00300 BEGIN "OVERSTRIKE"
00400 IFC CMUXGP THENC
00500 INTEGER Q;
00600 Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
00700 LASC[L]←LASC[L]-1; CHAR ← 0 MAX CHAR-1;
00800 CTRL(RUBOUT&'35); CHAR ← 0 MAX APPD(Q);
00900 ENDC
01000 IFC SAILXGP THENC WARN("Overstrike unimplemented") ENDC
01100 IFC PARCVER THENC
01200 PARCOVLY
01300 ENDC
01400 END
01500 ELSE IF F=RUBOUT THEN IF NOT XCRIBL THEN CHAR←APPD(SP) ELSE
01600 BEGIN
01700 CHAR ← 0 MAX APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
01800 END
01900 ELSE IMPOSSIBLE("0"&CVOS(F)&" Control Character") ;
02000
02100 comment 2 ... ALTMODE -- word break ;
02200 IF SHORTM AND G > FSTBRK THEN
02300 IFC SAILVER THENC IF DEVICE = MIC THEN CHANGESPACING ELSE ENDC
02400 BEGIN "SPREAD"
02500 TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
02600 IF RASTER THEN
02700 BEGIN "DOVSB"
02800 F ← ((TERMX-TERM) MIN SHORTM) ;
02900 IFC PARCVER THENC IF MICRO THEN PARCJUST ELSE ENDC
03000 CTRL(VARBLANK(F)) ;
03100 SHORTM← SHORTM-F
03200 END "DOVSB"
03300 ELSE CHAR ← 0 MAX CHAR + TERMX - TERM MIN IMC ;
03400 TERM ← TERMX ;
03500 END "SPREAD"
03600 ELSE IF RASTER THEN
03700 BEGIN
03800 CHAR ← 0 MAX APPD(SP);
03900 END;
04000
04100 comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
04200 END ; COMMENT three cases ;
04300 IFC SAILVER THENC IF CHORIZ NEQ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ; ENDC
04400 IFC SAILXGP THENC
04500 IF XCRIBL AND UNDERLINE GEQ 0 THEN
04600 CTRL(ESCAPE1&'47&BASELINE);
04700 ENDC
04800 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
04900 IFC PARCVER THENC PARCLOSE ENDC
05000 END "JUSTIFY" ;
00100 comment 5 ... LF ; BEGIN END ;
00200 END ; comment, by BRC ;
00300 END "PIECE"
00400 UNTIL PAGEBRC = LF ;
00500 END "LINE" ;
00600 END "COLUMN" ;
00700 END "AREA" ;
00800
00900 IFC PARCVER THENC PARCPAGE ENDC
01000
01100 BEGIN "FINPAGE"
01200 FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
01300
01400 F ← 120 - (IMC MAX 78) ;
01500
01600 FOR N ← 1 THRU LASL DO
01700 BEGIN "LIST LINE"
01800
01900 L ← N ;
02000 IF DEBUG AND LENGTH(S←SRCREF[L])>F AND DEVICE=LPT THEN
02100 S←S[1 TO F] ;
02200 NEEDCR ← FALSE ;
02300
02400 DO BEGIN "PART LINE"
02500 IF CHAR ← LASC[L] THEN
02600 BEGIN "NONBLANK"
02700 IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE)
02800 ELSE NEEDCR ← TRUE ; TES 11/1/73;
02900 OUT(LISTCHAN, FIXUP(IMG[L][1 TO CHAR+FAKE[L]])) ;
03000 IFC CMUVER THENC RKJ: 26-SEP-74 - KLUDGE;
03100 IF XCRIBL AND FIRST!OUTPUT THEN
03200 BEGIN
03300 FIRST!OUTPUT←FALSE;
03400 DUMMY←CHNCDB(LISTCHAN);
03500 START!CODE
03600 MOVE 1,DUMMY; HLRZ 1,2(1); MOVE 2,1(1);
03700 MOVEI 3,1; MOVEM 3,1(2);
03800 END;
03900 END;
04000 ENDC
04100 IF DEBUG AND L=N AND FULSTR(S) THEN OUT(LISTCHAN,
04200 (IF XCRIBL THEN XTABSTR(LFTMAR+IMC*CHARW+1)
04300 ELSE SPS((IMC MAX 80)-CHAR)) RKJ: 1-4-74;
04400 & S);
04500 END "NONBLANK" ;
04600 CHAR ← 0 MAX L ; L ← LINK[CHAR] ;
04700 LINK[CHAR] ← LASC[CHAR] ← FAKE[CHAR] ← 0 ;
04800 END "PART LINE" UNTIL L=0 ;
04900 OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
05000
05100 IF NEEDVERTI AND
05200 ((L ← LEADING[N+1]+RASTVERTI) IFC SAILXGP THENC NEQ ELSEC > ENDC INTRA) THEN
05300 IFC PARCVER THENC
05400 BEGIN
05500 OUT(LISTCHAN, ENDLINE) ;
05600 OUT(LISTCHAN, CTLK&CVS(L-INTRA)&".") ;
05700 END
05800 ENDC
05900 IFC CMUXGP THENC OUT(LISTCHAN, ENDLINE) ENDC COMMENT *** ;
06000 IFC SAILXGP THENC OUT(LISTCHAN, ESCAPE1&'42&(L+1)) ENDC BH 11/9/74 ;
06100 ELSE
06200 OUT(LISTCHAN, ENDLINE) ;
06300
06400 LEADING[N] ← 0 ; TES 11/4/74 ;
06500
06600 IF DEBUG THEN SRCREF[N] ← NULL ;
06700 END "LIST LINE" ;
06800
06900 FOR N ← LASL+1 THRU PAGEHIGH DO FAKE[N]←LINK[N]←0 ; TES 4/4/74 ;
07000
07100 IFC ITSVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
07200
07300 IFC PARCVER THENC
07400 OUT(LISTCHAN, ENDPAGE) ;
07500 ENDC
07600
07700 END "FINPAGE" ;
07800
07900 END "PAGE" ;
08000
08100 IF NOT (PAGEEOF OR PAGEHIGH LEQ 0) THEN DONE ; comment expand IMG ;
08200 RELEASE(ICHAN) ; RELEASE(SCHAN) ;
08300 END "FILE" ;
08400
08500 END "SIZE" UNTIL SEQEOF ;
00100 IFC PARCVER THENC PARCDOC ENDC
00200
00300 IFC SAILVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
00400
00500 RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
00600 END "INNER BLOCK" ;
00100 BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT ; K!OUT END ; COMMENT ** ** ** ** ** ;
00200
00300 OUTSTR("." & CRLF) ; comment signal terminal that pass two is done ;
00400 IF DELINT="A" OR DELINT="a" THEN
00500 BEGIN
00600 OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
00700 DELINT ← INCHWL ;
00800 END ;
00900 IF DELINT="Y" OR DELINT="y" THEN
01000 BEGIN "DELETE INTERMEDIATE FILES"
01100 IFC TENEX THENC
01200 SIMPLE PROCEDURE DELVER(STRING FINAME) ;
01300 BEGIN INTEGER CHN ;
01400 CHN ← OPENFILE(FINAME&";*", "RO*") ;
01500 DO DELF(CHN) UNTIL NOT INDEXFILE(CHN) ;
01600 RELEASE(CHN) ;
01700 END ;
01800 DELVER(JOBNO & ".PASS2") ;
01900 ENDC
02000 SEQCHAN ← READIN(
02100 IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
02200 FALSE, SEQBRC, SEQEOF) ;
02300 DO INPUT(SEQCHAN, TO!LF!APPD) UNTIL SEQBRC=LF;
02400 IFC TENEX THENC DELVER(IFILENAME & ".LABELS") ; ELSEC
02500 LABCHAN ← READIN("PULABL"&PUIEXT, FALSE, LABBRC, LABEOF) ;
02600 RENAME(LABCHAN, NULL, 0, I) ;
02700 RELEASE(LABCHAN);
02800 ENDC
02900 AWHILE DO
03000 BEGIN
03100 PAGEFILE ← SPARAM ;
03200 IF SEQEOF THEN DONE ;
03300 IFC TENEX THENC
03400 DELVER(IFILENAME & OCTEXT & PAGEFILE) ;
03500 DELVER(IFILENAME & TXTEXT & PAGEFILE) ;
03600 ELSEC
03700 IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
03800 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
03900 SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
04000 RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
04100 RELEASE(ICHAN); RELEASE(SCHAN);
04200 ENDC
04300 END ;
04400 IFC NOT TENEX THENC RENAME(SEQCHAN, NULL, 0, I) ENDC ;
04500 RELEASE(SEQCHAN) ;
04600 IFC TENEX THENC DELVER(IFILENAME & ".FILES") ; ENDC
04700 END "DELETE INTERMEDIATE FILES"
04800 ELSE IF DELINT NEQ "N" AND DELINT NEQ "n" THEN
04900 OUTSTR(CRLF&DELINT&"? -- INTERMEDIATE FILES WERE NOT DELETED") ;
05000
05100 IFC SAILVER THENC
05200 IF DEVICE = MIC THEN
05300 BEGIN "PASS 3"
05400 INTEGER FCHAN ;
05500 INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START!CODE MOVE 1, A ; END ;
05600 INTEGER ARRAY PASSTHREE[0:4] ;
05700 FCHAN ← WRITEON("$PUB$"&RPGEXT) ;
05800 OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
05900 RELEASE(FCHAN) ;
06000 PASSTHREE[0] ← CVSIX("DSK") ;
06100 PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
06200 PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
06300 OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
06400 CALL(CORELOC(PASSTHREE), "SWAP") ;
06500 END "PASS 3" ;
06600 IF XCRIBL THEN LODED("XSPOOL "&LISTFILE&CRLF);
06700 ENDC
06800
06900 IFC CMUVER THENC
07000 RKJ: 26-SEP-74 ALL NEW CODE;
07100 IF XCRIBL AND DOPASS3 THEN
07200 BEGIN "PASS 3"
07300 WTMPFILE("PB3",LISTFILE&CR&LF,TRUE);
07400 RUNPROG("DSK:PUB3[A700PU00]",1);
07500 START!CODE CALLI 0,'12 END;
07600 END "PASS 3";
07700 RKJ: NOW CHECK FOR MORE COMMANDS IN THE TMP FILE;
07800 IF RTMPFILE("PUB",S,FALSE,TRUE) THEN
07900 BEGIN "RERUN"
08000 RUNPROG("PUB",1);
08100 START!CODE CALLI 0,'12 END;
08200 END "RERUN";
08300 ENDC
08400
08500 IFC ISIVER THENC
08600 TES 8-OCT-74 APPROXIMATION TO WHAT ISI NEEDS;
08700 IF XCRIBL AND DOPASS3 THEN
08800 BEGIN "PASS 3"
08900 INTEGER J, JOBNO ;
09000 JOBNO ← CVS(GJINF(J, I, J)) ;
09100 J ← OPENFILE(JOBNO & ".PASS3", "WT") ;
09200 OUT(J, LISTFILE & CRLF) ;
09300 RELEASE(J) ;
09400 RUNPRG("<SUBSYS>PUB3.SAV", 1, 0) ;
09500 CALL(0,"EXIT") ;
09600 END "PASS 3" ;
09700 ENDC
09800 IFC TENEX THENC CALL(1,"EXIT") ; CALL(0,"EXIT"); ELSEC
09900 START!CODE IFC NOT ITSVER THENC CALLI 1,'12; ENDC CALLI 0,'12; END;
10000 ENDC
10100
10200 MAKEBE(WCW, CW) ;
10300
10400 END "VARIABLE BOUND ARRAY BLOCK" ;
10500
10600 END "PUB2" ;